Les Jeux paralympiques sont un événement sportif international majeur, regroupant les sports d’été ou d’hiver, auquel des milliers d’athlètes handicapés participent à travers différentes compétitions tous les quatre ans à la suite des Jeux olympiques, pour chaque olympiade. Y participent des athlètes atteints par un handicap physique, visuel ou mental. Ils sont organisés par le Comité international paralympique (et non pas par le Comité international olympique).
#install.packages("tidyverse")
#install.packages("rvest")
#install.packages("skimr")
#gère différents types de données et renvoie un objet skim_df qui peut être inclus dans un pipeline tidyverse ou affiché de manière élégante pour le lecteur humain.
#install.packages("reshape2")
#Ce package permet surtout le remodelage des données. Ses deux principales fonctions sont la fonction melt, qui permet le passage d’un jeu de données de la mise en forme large à la mise en forme longue, et la fonction cast, qui permet de réaliser l’inverse.
#install.packages("gganimate")
#Ce package permet d’ajouter des animations aux graphiques statiques produits à l’aide de ggplot2
#install.packages("magick")
#Traitement Facile des Images dans R à l’Aide du Package Magick
#install.packages("maps")
#pour la cartographie
# Chargement des données et des bibliothèques
library(tidyverse)
library(skimr)
library(knitr)
library(rvest)
library(reshape2)
library(gganimate)
library(magick)
library(maps)
library(kableExtra)
library(knitr)
SW <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/SW.csv')
SW
## # A tibble: 6,201 x 6
## gender event medal athlete abb year
## <chr> <chr> <chr> <chr> <chr> <dbl>
## 1 Men 25 m Freestyle 1A Gold KENNY Mike GBR 1980
## 2 Men 25 m Freestyle 1A Silver KANTOLA Pekka FIN 1980
## 3 Men 25 m Freestyle 1A Bronze TIETZE H. FRG 1980
## 4 Men 25 m Freestyle 1B Gold BURGER M. CAN 1980
## 5 Men 25 m Freestyle 1B Silver SLUPE G. USA 1980
## 6 Men 25 m Freestyle 1B Bronze MAKI Eero FIN 1980
## 7 Men 25 m Freestyle 1C Gold SMYK Zbigniew POL 1980
## 8 Men 25 m Freestyle 1C Silver EMMEL Manfred FRG 1980
## 9 Men 25 m Freestyle 1C Bronze OCKVIRK Robert USA 1980
## 10 Men 50 m Freestyle CP C Gold ADLER Kare NOR 1980
## # ... with 6,191 more rows
compter les medailles de chaque pays
medal_count<- SW %>%
group_by(abb, medal) %>%
summarize(Count=length(medal))
medal_count
## # A tibble: 172 x 3
## # Groups: abb [67]
## abb medal Count
## <chr> <chr> <int>
## 1 ARG Bronze 9
## 2 ARG Gold 5
## 3 ARG Silver 10
## 4 AUS Bronze 160
## 5 AUS Gold 147
## 6 AUS Silver 158
## 7 AUT Bronze 2
## 8 AUT Gold 2
## 9 AUT Silver 4
## 10 AZE Gold 1
## # ... with 162 more rows
ordonner les pays par nombre de medailles
ord_med <- medal_count %>%
group_by(abb) %>%
summarize(Total=sum(Count)) %>%
arrange(Total) %>%
select(abb)
ord_med
## # A tibble: 67 x 1
## abb
## <chr>
## 1 BAH
## 2 BUL
## 3 KAZ
## 4 LTU
## 5 MAR
## 6 TTO
## 7 VIE
## 8 IPP
## 9 SLO
## 10 TCH
## # ... with 57 more rows
medal_count$abb <- factor(medal_count$abb, levels=ord_med$abb)
le plot
ggplot(medal_count, aes(x=abb, y=Count, fill=medal)) +
geom_col() +
coord_flip() +
scale_fill_manual(values=c("gold4","gold1","gray70")) +
ggtitle("Le classement des pays par le total des médailles ") +
theme(plot.title = element_text(hjust = 0.5))
FR_gold <- SW %>% group_by(year, abb, medal) %>% filter(medal=="Gold", abb=='FRA') %>% summarize(Count=n()) %>% arrange(year) %>% group_by(year)
FR_gold
## # A tibble: 9 x 4
## # Groups: year [9]
## year abb medal Count
## <dbl> <chr> <chr> <int>
## 1 1980 FRA Gold 4
## 2 1984 FRA Gold 35
## 3 1988 FRA Gold 16
## 4 1992 FRA Gold 20
## 5 1996 FRA Gold 12
## 6 2000 FRA Gold 12
## 7 2004 FRA Gold 4
## 8 2008 FRA Gold 2
## 9 2012 FRA Gold 2
Le plot :
ggplot(FR_gold, aes(x=year, y=Count, group=medal)) +
geom_line(aes(colour=abb)) +
geom_point(aes(colour=abb))+
scale_x_continuous(breaks=FR_gold$year)+
theme(legend.position="none", legend.text=element_text(size=0),axis.text.x=element_text(size=8, angle=90,vjust=0,hjust=1))+
labs(title="le Nombre de medailles d'or de la France au fil du temps", x="années", y="Nombre de Medailles")
ggplot(SW,aes(x= gender ,fill= medal))+
geom_bar()+
scale_fill_manual(values=c("gold4","gold1","gray70")) +
ggtitle("nombre de medailles par sex ") +
theme(plot.title = element_text(hjust = 0.5))
ggplot(SW,aes(x= gender ,fill= medal))+
facet_wrap(~ year)+
geom_bar()+
scale_fill_manual(values=c("gold4","gold1","gray70")) +
ggtitle("nombre de medailles par sex pour chaque année ") +
theme(plot.title = element_text(hjust = 0.5))
Tableau de comptage du nombre d’athlètes par année et sexe:
counts_sex <- SW %>%
filter(gender != "Mixed")%>%
group_by(year,gender) %>%
summarize(Athletes = length(unique(athlete)))
counts_sex$year <- as.integer(counts_sex$year)
counts_sex
## # A tibble: 20 x 3
## # Groups: year [10]
## year gender Athletes
## <int> <chr> <int>
## 1 1980 Men 118
## 2 1980 Women 92
## 3 1984 Men 214
## 4 1984 Women 144
## 5 1988 Men 185
## 6 1988 Women 97
## 7 1992 Men 121
## 8 1992 Women 106
## 9 1996 Men 136
## 10 1996 Women 115
## 11 2000 Men 176
## 12 2000 Women 118
## 13 2004 Men 151
## 14 2004 Women 110
## 15 2008 Men 128
## 16 2008 Women 86
## 17 2012 Men 133
## 18 2012 Women 96
## 19 2016 Men 131
## 20 2016 Women 111
Le plot:
ggplot(counts_sex, aes(x=year, y=Athletes, group=gender, color=gender)) +
geom_point(size=2) +
geom_line() +
scale_color_manual(values=c("darkblue","red")) +
labs(title = "Le nombre des hommes et des femmes au fil des années") +
theme(plot.title = element_text(hjust = 0.5))
Le tableau des catégories les plus populaires par sexe :
popu_event <- SW %>%
filter(gender != "Mixed")%>%
group_by(event, gender) %>%
summarize(Count=n()) %>%
group_by(gender) %>%
top_n(5,event)
popu_event
## # A tibble: 10 x 3
## # Groups: gender [2]
## event gender Count
## <chr> <chr> <int>
## 1 50 m Freestyle S5 Women 21
## 2 50 m Freestyle S6 Women 21
## 3 50 m Freestyle S7 Men 21
## 4 50 m Freestyle S7 Women 21
## 5 50 m Freestyle S8 Men 21
## 6 50 m Freestyle S8 Women 21
## 7 50 m Freestyle S9 Men 21
## 8 50 m Freestyle S9 Women 21
## 9 75 m Individual Medley 1A Men 3
## 10 75 m Individual Medley 1B Men 3
Le plot:
ggplot(popu_event, aes(x=event, y=Count, group=gender, label=format(Count, big.mark=".", decimal.mark=","))) +
geom_col(aes(color=gender, fill=gender)) +
geom_text(position=position_stack(vjust=0.5), size=3, check_overlap=TRUE) +
scale_y_discrete() +
theme(legend.position="right", axis.text.x=element_text(size=10, angle=90,vjust=0,hjust=1))+
labs(title="les 5 catégories les plus populaires par sexe", x="Catégories", y="Nombre. athletes")
data_abb_medal <- dcast(medal_count, abb ~ medal)
data_abb_medal[is.na(data_abb_medal)] <- 0
no_gold_data <- subset(data_abb_medal, Gold == 0 & Silver>0 & Bronze>0)
no_gold_data
## abb Bronze Gold Silver
## 10 TCH 1 0 1
## 11 KUW 2 0 1
## 20 ZIM 3 0 2
## 25 POR 6 0 3
## 29 SUI 8 0 4
## 35 URS 9 0 11
print("les pays qui n'ont pas de médaille d'or mais ils ont les autres")
## [1] "les pays qui n'ont pas de médaille d'or mais ils ont les autres"
no_gold_data$abb
## [1] TCH KUW ZIM POR SUI URS
## 67 Levels: BAH BUL KAZ LTU MAR TTO VIE IPP SLO TCH KUW LUX CRO CYP HKG ... GBR
all_medal_sex <- SW%>% group_by(abb, medal, gender) %>%
summarise(total = n())
head(all_medal_sex)
## # A tibble: 6 x 4
## # Groups: abb, medal [4]
## abb medal gender total
## <chr> <chr> <chr> <int>
## 1 ARG Bronze Men 2
## 2 ARG Bronze Women 7
## 3 ARG Gold Women 5
## 4 ARG Silver Men 3
## 5 ARG Silver Women 7
## 6 AUS Bronze Men 63
all_medal_sex.wide <- dcast(all_medal_sex, abb ~ medal+gender)
all_medal_sex.wide[is.na(all_medal_sex.wide)] <- 0
head(all_medal_sex.wide)
## abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1 ARG 2 0 7 0 0 5
## 2 AUS 63 0 97 72 0 75
## 3 AUT 2 0 0 2 0 0
## 4 AZE 0 0 0 0 0 1
## 5 BAH 0 0 1 0 0 0
## 6 BEL 7 0 6 4 0 2
## Silver_Men Silver_Mixed Silver_Women
## 1 3 0 7
## 2 78 0 80
## 3 4 0 0
## 4 3 0 4
## 5 0 0 0
## 6 7 0 5
no_women_gold <- subset(all_medal_sex.wide, Gold_Women ==0 & Gold_Men>0 )
no_women_gold
## abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 3 AUT 2 0 0 2 0 0
## 7 BLR 9 0 0 21 0 0
## 12 COL 4 0 0 2 0 0
## 14 CUB 2 0 0 1 0 0
## 18 EGY 6 0 0 1 0 0
## 21 EUN 4 0 2 4 0 0
## 28 GRE 10 0 1 10 0 0
## 29 HKG 2 0 1 1 0 0
## 31 IPP 0 0 0 1 0 0
## 39 KOR 6 0 0 7 0 0
## 42 LUX 0 0 0 1 0 0
## 48 PER 2 0 0 2 0 0
## 56 SVK 2 0 1 2 0 0
## 59 THA 4 0 0 1 0 0
## 66 YUG 8 0 1 3 0 0
## Silver_Men Silver_Mixed Silver_Women
## 3 4 0 0
## 7 14 0 0
## 12 5 0 0
## 14 2 0 0
## 18 2 0 0
## 21 2 0 1
## 28 15 0 2
## 29 0 0 0
## 31 1 0 0
## 39 2 0 0
## 42 2 0 0
## 48 1 0 0
## 56 0 0 4
## 59 3 0 0
## 66 6 0 0
print(" Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté")
## [1] " Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté"
no_women_gold$abb
## [1] "AUT" "BLR" "COL" "CUB" "EGY" "EUN" "GRE" "HKG" "IPP" "KOR" "LUX" "PER"
## [13] "SVK" "THA" "YUG"
no_men_gold <- subset(all_medal_sex.wide, Gold_Women>0 & Gold_Men==0 )
no_men_gold
## abb Bronze_Men Bronze_Mixed Bronze_Women Gold_Men Gold_Mixed Gold_Women
## 1 ARG 2 0 7 0 0 5
## 4 AZE 0 0 0 0 0 1
## 15 CYP 0 0 1 0 0 2
## 20 EST 1 0 2 0 0 2
## 25 FRO 0 0 5 0 0 1
## 36 JAM 0 0 0 0 0 1
## 38 KAZ 0 0 0 0 0 1
## 53 SGP 0 0 1 0 0 3
## Silver_Men Silver_Mixed Silver_Women
## 1 3 0 7
## 4 3 0 4
## 15 0 0 1
## 20 0 0 5
## 25 0 0 7
## 36 0 0 3
## 38 0 0 0
## 53 0 0 1
print("Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté")
## [1] "Les pays où les hommes n'ont jamis remporté de médaille d'or mais où les femmes l'ont remporté"
no_men_gold$abb
## [1] "ARG" "AZE" "CYP" "EST" "FRO" "JAM" "KAZ" "SGP"
noc <- readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/noc_regions.csv')
noc = noc %>%
rename(abb = NOC)
noc
## # A tibble: 230 x 3
## abb region notes
## <chr> <chr> <chr>
## 1 AFG Afghanistan <NA>
## 2 AHO Curacao Netherlands Antilles
## 3 ALB Albania <NA>
## 4 ALG Algeria <NA>
## 5 AND Andorra <NA>
## 6 ANG Angola <NA>
## 7 ANT Antigua Antigua and Barbuda
## 8 ANZ Australia Australasia
## 9 ARG Argentina <NA>
## 10 ARM Armenia <NA>
## # ... with 220 more rows
Ajouter les noms complets des pays à notre base
data_regions <- SW %>%
left_join(noc,by="abb") %>%
filter(!is.na(region))
sous ensemble pour les jeux de 1980 et 2016,compter les athletes de chaque pays.
rio <- data_regions %>%
filter(year == "2016") %>%
group_by(region) %>%
summarize(Rio = length(unique(athlete)))
Arnhem_et_Veenendaal<- data_regions %>%
filter(year == "1980") %>%
group_by(region) %>%
summarize(Arnhem = length(unique(athlete)))
Creation des données pour la catographie
world <- map_data("world")
mapdat <- tibble(region=unique(world$region))
mapdat <- mapdat %>%
left_join(Arnhem_et_Veenendaal, by="region") %>%
left_join(rio, by="region")
mapdat$Arnhem[is.na(mapdat$Arnhem)] <- 0
mapdat$Rio[is.na(mapdat$Rio)] <- 0
world <- left_join(world, mapdat, by="region")
la catographie: Arnhem et Veenendaal 1980
ggplot(world, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = Arnhem)) +
labs(title = "Arnhem et Veenendaal 1980",
x = NULL, y = NULL) +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
panel.background = element_rect(fill = "navy"),
plot.title = element_text(hjust = 0.5)) +
guides(fill=guide_colourbar(title="Athletes")) +
scale_fill_gradient2(low="white",high = "red")
la catographie: Rio 2016
ggplot(world, aes(x = long, y = lat, group = group)) +
geom_polygon(aes(fill = Rio)) +
labs(title = "Rio 2016",
x = NULL, y = NULL) +
theme(axis.ticks = element_blank(),
axis.text = element_blank(),
panel.background = element_rect(fill = "navy"),
plot.title = element_text(hjust = 0.5)) +
guides(fill=guide_colourbar(title="Athletes")) +
scale_fill_gradient2(low="white",high = "red")
Rajouter une colonne continent:
continent <-readr::read_csv('https://raw.githubusercontent.com/youmrg/data_R/main/data.csv')
continent = continent %>%
rename(abb = Three_Letter_Country_Code)
medal_continent <- SW %>%
left_join(continent,by="abb") %>%
filter(!is.na(Continent_Name))
Le nombre de medailles en détail de chaque continent par année :
medal_continent<- medal_continent %>%
group_by(year,Continent_Name) %>%
summarize(Count=length(medal))
medal_continent
## # A tibble: 55 x 3
## # Groups: year [10]
## year Continent_Name Count
## <dbl> <chr> <int>
## 1 1980 Africa 1
## 2 1980 Asia 25
## 3 1980 Europe 238
## 4 1980 North America 119
## 5 1980 Oceania 13
## 6 1980 South America 13
## 7 1984 Africa 1
## 8 1984 Asia 38
## 9 1984 Europe 455
## 10 1984 North America 212
## # ... with 45 more rows
Le total des medailles de chaque continent :
sum_medal_cont <- medal_continent %>%
group_by(Continent_Name) %>%
summarize(nombre_de_medailles=sum(Count))
sum_medal_cont
## # A tibble: 6 x 2
## Continent_Name nombre_de_medailles
## <chr> <int>
## 1 Africa 10
## 2 Asia 765
## 3 Europe 2759
## 4 North America 1088
## 5 Oceania 528
## 6 South America 178
Le pourcentage de chaque continent dans le total des médailles :
pie_chart<- sum_medal_cont %>%
mutate(perc = `nombre_de_medailles` / sum(`nombre_de_medailles`)) %>%
arrange(perc) %>%
mutate(labels = scales::percent(perc))
pie_chart
## # A tibble: 6 x 4
## Continent_Name nombre_de_medailles perc labels
## <chr> <int> <dbl> <chr>
## 1 Africa 10 0.00188 0.2%
## 2 South America 178 0.0334 3.3%
## 3 Oceania 528 0.0991 9.9%
## 4 Asia 765 0.144 14.4%
## 5 North America 1088 0.204 20.4%
## 6 Europe 2759 0.518 51.8%
Le camembert :
ggplot(pie_chart, aes(x = "", y = perc, fill = Continent_Name)) +
geom_col() +
coord_polar(theta = "y")
Nous voulons ici que le nombre de médailles change en fonction des années et des continent. Nous utiliserons alors un diagramme à barres:
plot_anime1 <- ggplot(data = medal_continent) +
geom_col(mapping = aes(x = Continent_Name, y = Count),
fill = "darkcyan") +
theme_classic() +
xlab("Continent") +
ylab("Nombre de médailles ") +
transition_states(year,
transition_length = 2,
state_length = 1,
wrap = TRUE) +
ggtitle("Année : {closest_state}")
plot_anime1
Les diagrammes à barres peuvent être intéressants pour comparer les données d’une seule année à la fois entre elles, mais ne permettent pas de comparer la progression du nombre de medailles par année sur un seul plan de vue. Nous pourrions alors créer un graphique à lignes avec geom_line.
plot_anime2 <- ggplot(data = medal_continent, aes(x = year, y = Count, group=Continent_Name, color=Continent_Name)) +
geom_line() +
geom_point() +
ggtitle("Nombre de médailles entre 1980 et 2016") +
ylab("Nombre de médailles") +
xlab("Année")+
theme_classic()+
view_follow(fixed_x = TRUE,
fixed_y = TRUE) +
transition_reveal(year)
plot_anime2 <- animate(plot_anime2, end_pause = 15)
plot_anime2
Pourriez-vous corriger le bug et assigner le bon couleur aux médailles?
Pour le bug j’ai testé avec des amis et normalement ça marche . Voici les graphiques des questions 1,3,4 àpres la correction des couleurs : Question 1
ggplot(medal_count, aes(x=abb, y=Count, fill=medal)) +
geom_col() +
coord_flip() +
scale_fill_manual(values=c("gold4","gold1","gray70")) +
ggtitle("Le classement des pays par le total des médailles ") +
theme(plot.title = element_text(hjust = 0.5))
Question 3:
ggplot(SW,aes(x= gender ,fill= medal))+
geom_bar()+
scale_fill_manual(values=c("gold4","gold1","gray70")) +
ggtitle("nombre de medailles par sex ") +
theme(plot.title = element_text(hjust = 0.5))
Question 4:
ggplot(SW,aes(x= gender ,fill= medal))+
facet_wrap(~ year)+
geom_bar()+
scale_fill_manual(values=c("gold4","gold1","gray70")) +
ggtitle("nombre de medailles par sex pour chaque année ") +
theme(plot.title = element_text(hjust = 0.5))
dcast()Vous avez utilisé la fonction dcast. Quel est son rôle? Qu’est-ce qu’elle fait? Pourriez-vous faire la même action avec une ou plusieurs fonctions qu’on a vu en cours?
La fonction dcast est une fonction proposée par le package {reshape2}. Elle prend une série de lignes pour mettre leur contenu sous forme de plusieurs colonnes.Des lignes pivot restant orientées à l’indentique-leur contenu est juste recopié doivent etre proposées.l’idée est de passer d’une table “haute”(avec de nombreuses lignes mais peu de colonnes) à une table “large” (avec de nombreuses colonnes).La fonction qui réalise l’inverse de dcast est la fonction melt l’opération inverse : d’une table large on passe à une table haute . Il faut donc faire attention à ce que ces variables aient un nombre limité de valeurs, pour ne pas obtenir une table extrêmement large.
La fonction pivot_wider() du package {tidyr} permet d’élargir ses données en augmentant le nombre de colonnes et en diminuant le nombre de lignes elle propose la meme action que dcast et la fonction qui fait son inverse est pivot_longer() .
pivot_wider prend deux arguments principaux : names_from: indique la colonne contenant les noms des nouvelles variables à créer values_from indique: la colonne contenant les valeurs de ces variables. Il peut arriver que certaines variables soient absentes pour certaines observations. Dans ce cas l’argument values_fill permet de spécifier la valeur à utiliser pour ces données manquantes .
Question 7:
pivo <- medal_count %>%
select(medal,Count) %>%
pivot_wider(names_from = medal, values_from = Count ,values_fill = 0)
head(pivo) %>%
kbl() %>%
kable_styling()
| abb | Bronze | Gold | Silver |
|---|---|---|---|
| ARG | 9 | 5 | 10 |
| AUS | 160 | 147 | 158 |
| AUT | 2 | 2 | 4 |
| AZE | 0 | 1 | 7 |
| BAH | 1 | 0 | 0 |
| BEL | 13 | 6 | 12 |
no_gold_data <- subset(pivo, Gold == 0 & Silver>0 & Bronze>0)
no_gold_data %>%
kbl() %>%
kable_styling()
| abb | Bronze | Gold | Silver |
|---|---|---|---|
| KUW | 2 | 0 | 1 |
| POR | 6 | 0 | 3 |
| SUI | 8 | 0 | 4 |
| TCH | 1 | 0 | 1 |
| URS | 9 | 0 | 11 |
| ZIM | 3 | 0 | 2 |
print("les pays qui n'ont pas de médaille d'or mais ils ont les autres")
## [1] "les pays qui n'ont pas de médaille d'or mais ils ont les autres"
no_gold_data$abb
## [1] KUW POR SUI TCH URS ZIM
## 67 Levels: BAH BUL KAZ LTU MAR TTO VIE IPP SLO TCH KUW LUX CRO CYP HKG ... GBR
Question 8:
all_medal_sex <- SW%>% group_by(abb, medal, gender) %>%
summarise(total = n())
head(all_medal_sex) %>%
kbl() %>%
kable_styling()
| abb | medal | gender | total |
|---|---|---|---|
| ARG | Bronze | Men | 2 |
| ARG | Bronze | Women | 7 |
| ARG | Gold | Women | 5 |
| ARG | Silver | Men | 3 |
| ARG | Silver | Women | 7 |
| AUS | Bronze | Men | 63 |
pivo2 <- all_medal_sex %>%
pivot_wider(names_from = c(medal,gender), values_from =total,values_fill = 0) %>%
group_by(abb)
head(pivo2) %>%
kbl() %>%
kable_styling()
| abb | Bronze_Men | Bronze_Women | Gold_Women | Silver_Men | Silver_Women | Gold_Men | Silver_Mixed | Gold_Mixed | Bronze_Mixed |
|---|---|---|---|---|---|---|---|---|---|
| ARG | 2 | 7 | 5 | 3 | 7 | 0 | 0 | 0 | 0 |
| AUS | 63 | 97 | 75 | 78 | 80 | 72 | 0 | 0 | 0 |
| AUT | 2 | 0 | 0 | 4 | 0 | 2 | 0 | 0 | 0 |
| AZE | 0 | 0 | 1 | 3 | 4 | 0 | 0 | 0 | 0 |
| BAH | 0 | 1 | 0 | 0 | 0 | 0 | 0 | 0 | 0 |
| BEL | 7 | 6 | 2 | 7 | 5 | 4 | 0 | 0 | 0 |
no_women_gold <- subset(pivo2, Gold_Women ==0 & Gold_Men>0 )
no_women_gold %>%
kbl() %>%
kable_styling()
| abb | Bronze_Men | Bronze_Women | Gold_Women | Silver_Men | Silver_Women | Gold_Men | Silver_Mixed | Gold_Mixed | Bronze_Mixed |
|---|---|---|---|---|---|---|---|---|---|
| AUT | 2 | 0 | 0 | 4 | 0 | 2 | 0 | 0 | 0 |
| BLR | 9 | 0 | 0 | 14 | 0 | 21 | 0 | 0 | 0 |
| COL | 4 | 0 | 0 | 5 | 0 | 2 | 0 | 0 | 0 |
| CUB | 2 | 0 | 0 | 2 | 0 | 1 | 0 | 0 | 0 |
| EGY | 6 | 0 | 0 | 2 | 0 | 1 | 0 | 0 | 0 |
| EUN | 4 | 2 | 0 | 2 | 1 | 4 | 0 | 0 | 0 |
| GRE | 10 | 1 | 0 | 15 | 2 | 10 | 0 | 0 | 0 |
| HKG | 2 | 1 | 0 | 0 | 0 | 1 | 0 | 0 | 0 |
| IPP | 0 | 0 | 0 | 1 | 0 | 1 | 0 | 0 | 0 |
| KOR | 6 | 0 | 0 | 2 | 0 | 7 | 0 | 0 | 0 |
| LUX | 0 | 0 | 0 | 2 | 0 | 1 | 0 | 0 | 0 |
| PER | 2 | 0 | 0 | 1 | 0 | 2 | 0 | 0 | 0 |
| SVK | 2 | 1 | 0 | 0 | 4 | 2 | 0 | 0 | 0 |
| THA | 4 | 0 | 0 | 3 | 0 | 1 | 0 | 0 | 0 |
| YUG | 8 | 1 | 0 | 6 | 0 | 3 | 0 | 0 | 0 |
print(" Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté")
## [1] " Les pays où les femmes n'ont jamis remporté de médaille d'or mais où les hommes l'ont remporté"
no_women_gold$abb
## [1] "AUT" "BLR" "COL" "CUB" "EGY" "EUN" "GRE" "HKG" "IPP" "KOR" "LUX" "PER"
## [13] "SVK" "THA" "YUG"
Vous vez utilisé gganimate. Très bien! Pourriez-vous aussi produire un plot qui montre (et anime) la somme cumulative des médailles d’or au fil du temps pour la France, l’Italie, la Grande Bretagne et l’Allemagne?
Le nombre de medailles en détail de chaque pays par année :
#on mets les pays dans un pays pour pouvoir après les filtrer
target <- c("FRA","ITA","GBR","GER")
#la somme cumulative des médailles d'or au fil du temps
medail_cum<-SW %>%
select(abb, medal,year) %>%
filter(medal == "Gold") %>%
group_by(abb,year) %>%
summarise(Nb_m=n()) %>%
mutate(med_cum = cumsum(Nb_m)) %>%
filter(abb %in% target)
medail_cum %>%
kbl() %>%
kable_styling()
| abb | year | Nb_m | med_cum |
|---|---|---|---|
| FRA | 1980 | 4 | 4 |
| FRA | 1984 | 35 | 39 |
| FRA | 1988 | 16 | 55 |
| FRA | 1992 | 20 | 75 |
| FRA | 1996 | 12 | 87 |
| FRA | 2000 | 12 | 99 |
| FRA | 2004 | 4 | 103 |
| FRA | 2008 | 2 | 105 |
| FRA | 2012 | 2 | 107 |
| GBR | 1980 | 18 | 18 |
| GBR | 1984 | 26 | 44 |
| GBR | 1988 | 36 | 80 |
| GBR | 1992 | 22 | 102 |
| GBR | 1996 | 19 | 121 |
| GBR | 2000 | 20 | 141 |
| GBR | 2004 | 23 | 164 |
| GBR | 2008 | 14 | 178 |
| GBR | 2012 | 7 | 185 |
| GBR | 2016 | 19 | 204 |
| GER | 1992 | 26 | 26 |
| GER | 1996 | 31 | 57 |
| GER | 2000 | 2 | 59 |
| GER | 2004 | 5 | 64 |
| GER | 2008 | 1 | 65 |
| GER | 2012 | 2 | 67 |
| ITA | 1984 | 3 | 3 |
| ITA | 1988 | 5 | 8 |
| ITA | 1992 | 2 | 10 |
| ITA | 1996 | 2 | 12 |
| ITA | 2004 | 1 | 13 |
| ITA | 2008 | 1 | 14 |
| ITA | 2012 | 2 | 16 |
| ITA | 2016 | 2 | 18 |
Pour comparer la progression de la somme de medailles par année sur un seul plan de vue. Nous pourrions alors créer un graphique à lignes avec geom_line :
plot_cum <- ggplot(data = medail_cum, aes(x = year, y = med_cum, group=abb, color=abb)) +
geom_line() +
geom_point() +
ggtitle("La somme cumulative des médailles d'or au fil du temps") +
ylab("Nombre de médailles") +
xlab("Année")+
theme_classic()+
view_follow(fixed_x = TRUE,
fixed_y = TRUE) +
transition_reveal(year)
plot1 <- animate(plot_cum , end_pause = 10)
plot1
Nous voulons ici que la somme cumulative de médailles d’or change en fonction des années et des pays. Nous utiliserons alors un diagramme à barres:
#Pour créer notre animation de graphique à barres, nous analyserons l'évolution des pays avec leur nombre de medailles d'or sur l'ensemble de données de medail_cum. Pour ce faire, nous devons d'abord obtenir le classement des pays chaque année. C'est quelque chose que nous pouvons facilement faire avec dplyr :
medail_cum1 <- medail_cum %>%
group_by(year) %>%
arrange(year, desc(med_cum)) %>%
mutate(ranking = row_number())
medail_cum1 %>%
kbl() %>%
kable_styling()
| abb | year | Nb_m | med_cum | ranking |
|---|---|---|---|---|
| GBR | 1980 | 18 | 18 | 1 |
| FRA | 1980 | 4 | 4 | 2 |
| GBR | 1984 | 26 | 44 | 1 |
| FRA | 1984 | 35 | 39 | 2 |
| ITA | 1984 | 3 | 3 | 3 |
| GBR | 1988 | 36 | 80 | 1 |
| FRA | 1988 | 16 | 55 | 2 |
| ITA | 1988 | 5 | 8 | 3 |
| GBR | 1992 | 22 | 102 | 1 |
| FRA | 1992 | 20 | 75 | 2 |
| GER | 1992 | 26 | 26 | 3 |
| ITA | 1992 | 2 | 10 | 4 |
| GBR | 1996 | 19 | 121 | 1 |
| FRA | 1996 | 12 | 87 | 2 |
| GER | 1996 | 31 | 57 | 3 |
| ITA | 1996 | 2 | 12 | 4 |
| GBR | 2000 | 20 | 141 | 1 |
| FRA | 2000 | 12 | 99 | 2 |
| GER | 2000 | 2 | 59 | 3 |
| GBR | 2004 | 23 | 164 | 1 |
| FRA | 2004 | 4 | 103 | 2 |
| GER | 2004 | 5 | 64 | 3 |
| ITA | 2004 | 1 | 13 | 4 |
| GBR | 2008 | 14 | 178 | 1 |
| FRA | 2008 | 2 | 105 | 2 |
| GER | 2008 | 1 | 65 | 3 |
| ITA | 2008 | 1 | 14 | 4 |
| GBR | 2012 | 7 | 185 | 1 |
| FRA | 2012 | 2 | 107 | 2 |
| GER | 2012 | 2 | 67 | 3 |
| ITA | 2012 | 2 | 16 | 4 |
| GBR | 2016 | 19 | 204 | 1 |
| ITA | 2016 | 2 | 18 | 2 |
Voici la deuxième animation :
plot_cum2 <- medail_cum1 %>%
ggplot() +
geom_col(aes(ranking, med_cum, fill = abb)) +
geom_text(aes(ranking, med_cum, label = med_cum), hjust=-0.1) +
geom_text(aes(ranking, y=0 , label = abb), hjust=1.1) +
geom_text(aes(x=4, y=max(med_cum) , label = as.factor(year)), vjust = 0.2, alpha = 0.5, col = "gray", size = 20) +
ggtitle("la somme cumulative des médailles d'or au fil du temps") +
coord_flip(clip = "off", expand = FALSE) + scale_x_reverse() +
theme_minimal() + theme(
panel.grid = element_blank(),
legend.position = "none",
axis.ticks.y = element_blank(),
axis.title.y = element_blank(),
axis.text.y = element_blank(),
plot.margin = margin(1, 4, 1, 3, "cm")
) +
transition_states(year, state_length = 0, transition_length = 2) +
enter_fade() +
exit_fade() +
ease_aes('quadratic-in-out')
plot2 <- animate(plot_cum2,width = 700, height = 432, fps = 25, duration = 15, rewind = FALSE)
plot2